home *** CD-ROM | disk | FTP | other *** search
- {.$A+,B-,D+,E-,F+,G-,I+,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+,Y+}
- Unit RipLink;
- {.$D-,L-,Y-}
- {$F+,O+}
-
- { RipLink(tm) - Version 1.21 - 03/22/1995 }
- { Copyright (C) 1995 by InterProgramming }
- { All rights reserved. }
-
- { RIPscrip is a Trademark of TeleGrafix Communications, Inc. }
-
- { All graphics routines are contained in RIPLINK.PA1. }
- { All font tables are contained in RIPLINK.PA2. }
- { Additional routines are in RIPLINK1.PAS. }
-
- {$DEFINE INTDRIV} { Either INTDRIV or FONTFILE should be defined. }
- {.$DEFINE FONTFILE} { INTDRIV is the ALL model and FONTFILE is the }
- {.$DEFINE TP55} { EXT model. The INT model is no longer }
- {.$DEFINE TP6} { supported. MOUSE defines whether the mouse }
- {$DEFINE MOUSE} { is to be used or not. DEBUGIT and DEBUGPAUSE }
- {.$DEFINE DEBUGIT} { are for debugging. See the RIPscrip Parser }
- {.$DEFINE DEBUGPAUSE} { for additional info. If DOUBLENUM is defined, }
- {.$DEFINE DOUBLENUM} { then $N+,E+ must also be defined. While the }
- {.$N+,E+} { RIPscrip standard calls for Double Nums, we }
- {.$DEFINE USEOPRO} { found no noticible different and decided to go }
- { with Reals as the default because of the speed }
- { difference. USEOPRO is for users of Turbo }
- { Power's Object Professional. }
-
- {Absolute coords - RipMouse.AddRegion}
-
- interface
-
- uses
- Dos, Graph, RipLink1,
- {$IFDEF USEOPRO}
- OpCrt;
- {$ELSE}
- Crt;
- {$ENDIF}
-
- const
- TheRIPCopyright = ' RIPlink(tm) - Copyright (C) 1995 by Thomas E. Morgan and InterProgramming, All Rights Reserved. ';
- TheRIPCopyright2= ' Portions Copyright 1995 by Thomas E. Morgan and InterProgramming ';
-
- {$IFDEF INTDRIV} CantHaveIntDrivAndFontFileBothDefined = 1; {$ENDIF}
- {$IFDEF FONTFILE}CantHaveIntDrivAndFontFileBothDefined = 1; {$ENDIF}
-
- AnsiMaxParams = 5; {maximum parameters for our ansi interpreter}
- eNone = 0; {no command, ignore this char}
- eChar = 1; {no command, process the char}
- eGotoXY = 2; {absolute goto cursor position call}
- eUp = 3; {cursor up}
- eDown = 4; {cursor down}
- eRight = 5; {cursor right}
- eLeft = 6; {cursor left}
- eClearBelow = 7; {clear screen below cursor}
- eClearAbove = 8; {clear screen above cursor}
- eClearScreen = 9; {clear entire screen}
- eClearEndofLine = 10; {clear from cursor to end of line}
- eClearStartOfLine = 11; {clear from cursor to the start of line}
- eClearLine = 12; {clear entire line that cursor is on}
- eSetMode = 13; {set video mode}
- eSetBackground = 14; {set background attribute}
- eSetForeground = 15; {set foreground attribute}
- eSetAttribute = 16; {set video attribute (foreground and background)}
- eSaveCursorPos = 17; {save cursor position}
- eRestoreCursorPos = 18; {restore cursor position}
- eDeviceStatusReport = 19; {report device status or cursor position}
- eError = 255;{indicates a parser error}
- Escape = #27;
- LeftBracket = #91;
- Semicolon = #59;
- FormFeed = #12;
- iQueueSize = 32;
-
- TextOffsetX : array[0..4] of Byte = ( 8, 7, 8, 7,16);
- TextOffsetY : array[0..4] of Byte = ( 8, 8,14,14,14);
- TextMaxX : array[0..4] of Byte = (79,90,79,90,39);
- TextMaxY : array[0..4] of Byte = (42,42,24,24,24);
-
- type
- Str2 = string[2];
- Str4 = string[4];
- Str12 = string[12];
- Str50 = string[50];
-
- fpt = array[1..8] of byte;
-
- ParseStatus = (None,Got_Excl,Got_Pipe,Got_Level,Got_SubLevel,Got_Command);
- CharStatus = (cNone,Pending,ContLine,Escaped);
- LastCharStatus= (lNone,lChar,lCR,lLF,lPipe,lBackSlash,lExcl);
-
- MouseRegionRecord = record
- x0,y0,x1,y1 : word;
- invert,reset : boolean;
- thetext : str50;
- end; {61}
-
- QueueType = Array[1..255] of Char;
- QueuePtr = ^QueueType;
-
- AnsiParserType = (GotNone,GotEscape,GotBracket,GotSemiColon,GotParam,GotCommand);
-
- CommandRecord = record
- Ch : Char;
- Cmd : Byte;
- X, Y : Byte;
- end;
-
- RootPtr = ^Root;
- Root = object
- constructor Init;
- destructor Done; virtual;
- end;
-
- RipPtr = ^RipObj;
- RipObj = object(Root)
- {general}
- TMaxX0, TMaxY0, TMaxX1, TMaxY1 : word;
- DefColor : word;
- CurFont : byte;
- CurSize : byte;
- Metric : MetricRec;
- ClipB : Pointer;
- ClipSize : word;
- IconDir : DirStr;
- StatText : String[79];
- LocalRip : boolean;
- {$IFDEF FONTFILE}
- charfile : file;
- FontPtr : Pointer;
- FontSize : word;
- DriverPtr : Pointer;
- {$ENDIF}
- {button info}
- ButPlainWidth, ButPlainHeight, ButOrientation, ButFlags,
- ButBevelSize, ButLabelFore, ButLabelDropShadow, ButPlainHilite,
- ButPlainShadow, ButPlainSurface, ButGroupNum, ButFlags2,
- ButLabelUnderline, ButCorner : word;
- {mouse}
- {$IFDEF MOUSE}
- MouseExist : boolean;
- IsMouseOn : boolean;
- LastStatus, {used for CheckMouse}
- LastX, { " }
- LastY : word; { " }
- RegionArray : Array[1..128] of MouseRegionRecord;
- LastButton : Byte; {how many regions are there?}
- Inverted : byte; {which region is currently inverted}
- CurRegion : Byte; {temp var for CheckMouse}
- CurButton : Byte; {which button are we working with?}
- KeyBuf : Array[1..250] of Char; {Input Buffer}
- KeyBufHead : Byte; {Head of Input Buffer}
- KeyBufTail : Byte; {Tail of Input Buffer}
- {$ENDIF}
- {ansi parser}
- QueueSize : Byte; {size of our queue}
- aTextAttr : Byte; {set to Crt's TextAttr on Init}
- QueueIndex : Byte; {current index into queue}
- Queue : QueuePtr; {ptr to our queue}
- Params : Array[1..AnsiMaxParams] of String[5]; {parameter strings}
- ParamInt : Array[1..AnsiMaxParams] of Integer; {params as ints}
- ParamIndex : Byte; {last param's index}
- Inverse : Boolean;
- Intense : Boolean;
- Blink : Boolean;
- Invis : Boolean;
- ParserState : AnsiParserType;
- {rip parser}
- Level,SubLevel: byte;
- command : char;
- firstcmd,
- nextcommand,
- commanddone,
- didrip : boolean;
- pstat : parsestatus;
- cstat : charstatus;
- lstat : lastcharstatus;
- lastc : char;
- rBuffer : Array[1..1024] of char;
- bufcount : word;
- {text window} {char/color}
- VirtualWindow : Array[0..90,0..42,0..1] of Byte;
- TextX0 : byte;
- TextY0 : byte;
- TextX1 : byte;
- TextY1 : byte;
- TextSize : byte; {8x8/7x8/8x14/7x14/16x14}
- TextWrap : boolean;
- TextActive : boolean;
- TextClr : byte; {color}
- CursorX : byte;
- CursorY : byte;
- CursorSaveX : byte;
- CursorSaveY : byte;
- CursorOn : boolean;
- CmdRec : CommandRecord; {for ansi parser}
- TextFontFile : File of CharMapRecord;
- TextChar : CharMapRecord;
- {other}
- {$IFDEF DEBUGIT}
- log : text;
- {$ENDIF}
-
- constructor Init(userip : boolean;fontname:string);
- procedure RipTextWindow(x0,y0,x1,y1 : byte; wrap : boolean; size : byte);
- procedure RipViewPort(x0,y0,x1,y1 : word);
- procedure RipResetWindows;
- procedure RipEraseWindow;
- procedure RipEraseView;
- procedure RipGotoXY(x0,y0 : byte);
- procedure RipHome;
- procedure RipEraseEOL;
- procedure RipColor(clr : byte);
- procedure RipSetPalette(c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16 : word);
- procedure RipOnePalette(color,value : word);
- procedure RipWriteMode(mode : byte);
- procedure RipMove(x0,y0 : word);
- procedure RipText(instr : string);
- procedure RipTextXY(x0,y0 : word; instr : string);
- procedure RipFontStyle(font, direct, size : byte);
- procedure RipPixel(x0,y0 : word);
- procedure RipLine(x0,y0,x1,y1 : word);
- procedure RipRectangle(x0,y0,x1,y1 : word);
- procedure RipBar(x0,y0,x1,y1 : word);
- procedure RipCircle(x0,y0,radius : word);
- procedure RipOval(x0,y0,stangle,endangle,xrad,yrad : word);
- procedure RipFilledOval(x0,y0,xrad,yrad : word);
- procedure RipArc(x0,y0,stangle,endangle,rad : word);
- procedure RipOvalArc(x0,y0,stangle,endangle,xrad,yrad : word);
- procedure RipPieSlice(x0,y0,stangle,endangle,rad : word);
- procedure RipOvalPieSlice(x0,y0,stangle,endangle,radx,rady : word);
- procedure RipBezier(x0,y0,x1,y1,x2,y2,x3,y3,count : word);
- procedure RipPolygon(numpoints : word; var polypoints);
- procedure RipFillPoly(numpoints : word; var polypoints);
- procedure RipPolyLine(NumPoints : word; var polypoints);
- procedure RipFill(x0,y0,border : word);
- procedure RipLineStyle(style,pattern,thick : word);
- procedure RipFillStyle(style,color : word);
- procedure RipFillPattern(pattern : fpt; color : word);
- procedure RipMouse(x0,y0,x1,y1 : word; click, clear : boolean; instr : string);
- procedure RipKillMouseFields;
- procedure RipBeginText(x0,y0,x1,y1 : word);
- procedure RipRegionText(Justify : boolean; instr : string);
- procedure RipEndText;
- procedure RipGetImage(x0,y0,x1,y1 : word);
- procedure RipPutImage(x0,y0,mode : word);
- procedure RipWriteIcon(fname : str12);
- procedure RipLoadIcon(x0,y0,mode : word; clipbrd : boolean; fname : str12);
- procedure RipButtonStyle(wid,hgt,orient,flags,bevsize,dfore,dback,bright,dark,
- surface,grp_no,flags2,uline_col,corner_col : word);
- procedure RipButton(x0,y0,x1,y1,hotkey : word; flags : byte; icon : str12; sLabel : string; Cmd : string);
- procedure RipDefine(flags : word; textvar : str12; width : byte; ques, default : string);
- procedure RipQuery(mode : byte; instr : string);
- procedure RipCopyRegion(x0,y0,x1,y1,destline : word);
- procedure RipReadScene(fname : str12);
- procedure RipFileQuery(mode : word; fname : str12);
- procedure RipEnterBlockMode(ul : boolean; proto,ftype : word; fname : str12);
- procedure RipNoMore;
- procedure SendStr(instr : string); virtual;
- procedure SendStrCR(instr : string); virtual;
- procedure StatLine;
- destructor Done; virtual;
- Function DisplayRIPfile(Path : string): boolean;
- Procedure ResetParser;
- Procedure ResetParser2(c:char);
- Procedure DumpBuffer;
- Procedure DumpBuffer2;
- Procedure ParseRipStr(s:string;sendchar:boolean);
- Procedure ParseRip(c : char; sendchar : boolean);
- Procedure DoTextStr(s:string);
- Procedure DoTextChar(c:char);
- {$IFDEF MOUSE}
- Procedure MouseInit;
- Procedure MouseOn;
- Procedure MouseOff;
- Procedure GetPosition(var ButtonStatus,xPos,yPos:Integer);
- Procedure SetMousePos(x,y:Integer);
- Procedure IsButtonDown(Button:Integer; var Status,DnCount,xPos,yPos:Integer);
- Procedure IsButtonUp(Button:Integer; var Status,UpCount,xPos,yPos:Integer);
- Procedure CheckMouse;
- Function InRegion(x,y:word):byte;
- Procedure DoInvert(region:byte;InvertIt:boolean);
- Procedure AddRegion(x0,y0,x1,y1:word;invert,reset:boolean;thetext:str50);
- Function CharInBuffer: boolean;
- Function GetNextChar:char;
- Procedure AddString(st:string);
- Procedure KillRegions;
- Procedure KillBuffer;
- {$ENDIF}
- {$IFNDEF TP55}
- private
- {$ENDIF}
- Procedure rTextWindow(x0,y0,x1,y1:byte; wrap:boolean; size:byte);
- Procedure rViewPort(x0,y0,x1,y1:word);
- Procedure rResetWindows;
- Procedure rEraseWindow;
- Procedure rEraseView;
- Procedure rGotoXY(x0,y0:byte);
- Procedure rHome;
- Procedure rEraseEOL;
- Procedure rColor(clr:byte);
- Procedure rSetPalette(c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16:word);
- Procedure rOnePalette(color,value:word);
- Procedure rWriteMode(mode:byte);
- Procedure rMove(x0,y0:word);
- Procedure rText(instr:string);
- Procedure rTextXY(x0,y0:word; instr:string);
- Procedure rFontStyle(font,direct,size:byte);
- Procedure rPixel(x0,y0:word);
- Procedure rLine(x0,y0,x1,y1:word);
- Procedure rRectangle(x0,y0,x1,y1:word);
- Procedure rBar(x0,y0,x1,y1:word);
- Procedure rCircle(x0,y0,radius:word);
- Procedure rOval(x0,y0,stangle,endangle,xrad,yrad:word);
- Procedure rFilledOval(x0,y0,xrad,yrad:word);
- Procedure rArc(x0,y0,stangle,endangle,rad:word);
- Procedure rPieSlice(x0,y0,stangle,endangle,rad:word);
- Procedure rOvalPieSlice(x0,y0,stangle,endangle,radx,rady:word);
- Procedure rBezier(x0,y0,x1,y1,x2,y2,x3,y3,count:word);
- Procedure rPolygon(numpoints:word; var PolyPoints; Complete:boolean);
- Procedure rFillPoly(numpoints:word; var polypoints);
- Procedure rFill(x0,y0,border:word);
- Procedure rLineStyle(style,pattern,thick:word);
- Procedure rFillStyle(style,color:word);
- Procedure rFillPattern(pattern:fpt; color:word);
- Procedure rMouse(x0,y0,x1,y1:word; inv,reset:boolean; instr:string);
- Procedure rKillMouse;
- Procedure rGetImage(x0,y0,x1,y1:word);
- Procedure rPutImage(x0,y0,mode:word);
- Procedure rWriteIcon(fname:str12);
- Procedure rLoadIcon(x0,y0,mode:word; clipbrd:boolean; fname:str12);
- Procedure rButtonStyle(wid,hgt,orient,flags,bevsize,dfore,dback,bright,dark,
- surface,grp_no,flags2,uline_col,corner_col:word);
- Procedure rButton(tx0,ty0,tx1,ty1,hotkey:word; flags:byte; icon:str12; sLabel,Cmd:string);
-
- Function MegaBuf(tpos,a,b:byte):word;
- Function UnEscapeString(bStart,bEnd:word):string;
- Function DoRipChar(c : char): boolean;
-
- procedure ProcessChar(C : Char; var pCommand : CommandRecord);
- procedure PutQueue(C : Char);
- procedure InitParser;
- procedure BuildParam(C : Char);
- procedure ConvertParams(C : Char);
- procedure MakeCommand(C : Char; var pCommand : CommandRecord);
-
- Procedure DispChar(c:char);
- end;
-
- var
- RIPScriptFont : word;
- RIPSimplexFont : word;
- RIPTriplexScriptFont : word;
- RIPComplexFont : word;
- RIPEuropeanFont : word;
- RIPBoldFont : word;
-
- UnregDelay : Boolean;
-
- Implementation
-
- {$IFDEF INTDRIV}
- uses
- RipLinkMoreDrivers, RipLinkEvenMoreDrivers, RipLinkDriver;
- {$ENDIF}
-
- Var
- Registered : Boolean;
- Regs : registers;
-
-
- Constructor Root.Init;
- begin
- end;
-
- Destructor Root.Done;
- begin
- end;
-
- {$I RIPLINK.PA1}
-
- Constructor RipObj.Init(userip : boolean;fontname : string);
- var
- GrDriver : integer;
- GrMode : Integer;
- success : boolean;
- tres : integer;
- rnd1 : word;
- rnd2 : word;
- c : byte;
- begin
- if not Root.Init then
- fail;
-
- LocalRip := userip;
- success := true;
- TMaxX0 := Lo(WindMin)+1;
- TMaxY0 := Hi(WindMin)+1;
- TMaxX1 := Lo(WindMax)+1;
- TMaxY1 := Hi(WindMax)-1;
-
- level := 0;
- sublevel := 0;
- command := #0;
- firstcmd := true;
- nextcommand := false;
- commanddone := false;
- didrip := false;
- pstat := none;
- cstat := cnone;
- lastc := #0;
- fillchar(rbuffer,1024,#0);
- bufcount := 0;
-
- DefColor := 0;
- if LocalRip then
- begin
- RIPScriptFont := InstallUserFont('SCRI');
- if GraphResult <> grOk then
- success := false;
- RIPSimplexFont := InstallUserFont('SIMP');
- if GraphResult <> grOk then
- success := false;
- RIPTriplexScriptFont := InstallUserFont('TSCR');
- if GraphResult <> grOk then
- success := false;
- RIPComplexFont := InstallUserFont('LCOM');
- if GraphResult <> grOk then
- success := false;
- RIPEuropeanFont := InstallUserFont('EURO');
- if GraphResult <> grOk then
- success := false;
- {$IFNDEF TP6}
- RIPBoldFont := InstallUserFont('BOLD');
- if GraphResult <> grOk then
- success := false;
- {$ENDIF}
-
- {$IFDEF INTDRIV}
- if RegisterBGIDriver(@EGAVGADriver) < 0 then
- begin
- Root.Done;
- Fail;
- end;
-
- if RegisterBGIFont(@GothicFont) < 0 then
- success := false;
- if RegisterBGIFont(@LittFont) < 0 then
- success := false;
- if RegisterBGIFont(@SansSerifFont) < 0 then
- success := false;
- if RegisterBGIFont(@TripFont) < 0 then
- success := false;
-
- {$IFNDEF TP6}
- if RegisterBGIFont(@BoldFont) < 0 then
- success := false;
- {$ENDIF}
- if RegisterBGIFont(@EuroFont) < 0 then
- success := false;
- if RegisterBGIFont(@LComFont) < 0 then
- success := false;
- if RegisterBGIFont(@ScriptFont) < 0 then
- success := false;
- if RegisterBGIFont(@SimplexFont) < 0 then
- success := false;
- if RegisterBGIFont(@TriplexScriptFont) < 0 then
- success := false;
- {$ENDIF} {intdriv}
-
- if fontname = '' then
- fontname := 'RIPLINK';
-
- {$IFDEF FONTFILE}
- assign(charfile,fontname+'.CHR');
- {$I-}
- reset(charfile,1);
- {$I+}
- if ioresult <> 0 then
- success := false;
- GetMem(driverptr,5527);
- blockread(charfile,driverptr^,5527);
- if RegisterBGIdriver(driverptr) < 0 then
- success := false;
- FontPtr := nil;
- FontSize := 0;
- {$ENDIF} {fontfile}
-
- if not success then
- begin
- Root.Done;
- Fail;
- end;
-
- Grdriver := 0;
- GrMode := 0;
- DetectGraph(GrDriver, GrMode);
- case GrDriver of
- Graph.EGA : GrMode:=Graph.EGAHi;
- Graph.EGA64 : GrMode:=Graph.EGA64Hi;
- Graph.VGA : If GrMode<>Graph.VGAHi then
- GrMode:=Graph.VGAMed;
- else
- success := false;
- end;
-
- { GrDriver := Graph.EGA64;
- GrMode := Graph.EGA64Hi; }
- { GrDriver := Graph.VGA;
- GrMode := Graph.VGAHi; }
-
- InitGraph(GrDriver, GrMode,'');
- tres := graphresult;
- if tres <> grOk then
- success := false;
- SetTextJustify(LeftText,TopText);
- {ansi parser}
- if (MaxAvail < iQueueSize) or (iQueueSize = 0) then
- Fail;
- GetMem(Queue,iQueueSize);
- QueueSize := iQueueSize;
- QueueIndex := 0;
- aTextAttr := TextAttr;
- Intense := False;
- Inverse := False;
- Blink := False;
- Invis := False;
- InitParser;
- {text window}
- textx0 := 0; texty0 := 0;
- textx1 := 79; texty1 := 42;
- textsize := 0;
- textwrap := true;
- textclr := 15;
- textactive := true;
- cursorx := 0; cursory := 0;
- cursoron := false;
- fillchar(virtualwindow,7826,#0);
- filemode := $20;
- assign(textfontfile,fontname+'.FNT');
- {$I-}
- reset(textfontfile);
- {$I+}
- if IOresult <> 0 then
- success := false;
- end;
- if not success then
- begin
- Root.Done;
- Fail;
- end;
- ClipB := nil;
- ClipSize := 0;
- {$IFDEF MOUSE}
- mouseexist := false;
- if LocalRip then
- MouseInit;
- {$ENDIF}
- CurFont := 0;
- CurSize := 1;
- Metric := MetricArray[CurFont,CurSize];
- IconDir := '.\';
- StatText := 'RipLink v1.21';
- {$IFDEF DEBUGIT}
- assign(log,'riplink.log');
- if exists('riplink.log') then
- append(log)
- else
- rewrite(log);
- {$ENDIF}
- end;
-
- Destructor RipObj.Done;
- begin
- {$IFDEF DEBUGIT}
- close(log);
- {$ENDIF}
- if LocalRip then
- begin
- close(textfontfile);
- FreeMem(Queue,QueueSize);
- {$IFDEF MOUSE}
- regs.ax := $0000;
- intr($33,regs);
- mouseexist := (regs.ax = $ffff);
- ismouseon := false;
- {$ENDIF}
- if ClipB <> nil then
- begin
- FreeMem(ClipB,ClipSize);
- ClipB := nil;
- ClipSize := 0;
- end;
- CloseGraph;
- {$IFDEF FONTFILE}
- FreeMem(driverptr,5527);
- if fontptr <> nil then
- freemem(fontptr,fontsize);
- close(charfile);
- {$ENDIF}
- end;
- Root.Done;
- end;
-
- Procedure RipObj.RipTextWindow(x0, y0, x1, y1: byte; wrap : boolean; size : byte);
- var
- wtemp : char;
- begin
- rTextWindow(x0,y0,x1,y1,wrap,size);
- if wrap then
- wtemp := '1'
- else
- wtemp := '0';
- sendstrcr('!|w'+WordToMega(x0)+WordToMega(y0)+WordToMega(x1)+WordToMega(y1)+wtemp+inttostr(size));
- end;
-
- Procedure RipObj.RipViewPort(x0,y0,x1,y1 : word);
- begin
- rViewPort(x0,y0,x1,y1);
- sendstrcr('!|v'+WordToMega(x0)+WordToMega(y0)+WordToMega(x1)+WordToMega(y1));
- end;
-
- Procedure RipObj.RipResetWindows;
- begin
- rResetWindows;
- sendstrcr('!|*');
- end;
-
- Procedure RipObj.RipEraseWindow;
- begin
- rEraseWindow;
- sendstrcr('!|e');
- end;
-
- Procedure RipObj.RipEraseView;
- begin
- rEraseView;
- sendstrcr('!|E');
- end;
-
- Procedure RipObj.RipGotoXY(x0,y0 : byte);
- begin
- rGotoXY(x0,y0);
- sendstrcr('!|g'+WordToMega(x0)+WordToMega(y0));
- end;
-
- Procedure RipObj.RipHome;
- begin
- rHome;
- sendstrcr('!|H');
- end;
-
- Procedure RipObj.RipEraseEOL;
- begin
- rEraseEOL;
- sendstrcr('!|>');
- end;
-
- Procedure RipObj.RipColor(clr : byte);
- begin
- rColor(clr);
- sendstrcr('!|c'+wordtomega(clr));
- end;
-
- Procedure RipObj.RipSetPalette(c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16 : word);
- begin
- rSetPalette(c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16);
- sendstrcr('!|Q'+wordtomega(c1)+wordtomega(c2)+wordtomega(c3)+wordtomega(c4)+wordtomega(c5)+wordtomega(c6)+
- wordtomega(c7)+wordtomega(c8)+wordtomega(c9)+wordtomega(c10)+wordtomega(c11)+wordtomega(c12)+
- wordtomega(c13)+wordtomega(c14)+wordtomega(c15)+wordtomega(c16));
- end;
-
- Procedure RipObj.RipOnePalette(color,value : word);
- begin
- rOnePalette(color,value);
- sendstrcr('!|a'+wordtomega(color)+wordtomega(value));
- end;
-
- Procedure RipObj.RipWriteMode(Mode : Byte);
- begin
- rWriteMode(mode);
- sendstrcr('!|W'+wordtomega(mode));
- end;
-
- Procedure RipObj.RipMove(x0,y0 : word);
- begin
- rMove(x0,y0);
- sendstrcr('!|m'+wordtomega(x0)+wordtomega(y0));
- end;
-
- Procedure RipObj.RipText(instr : string);
- begin
- rText(instr);
- sendstrcr('!|T'+escapestring(instr));
- end;
-
- Procedure RipObj.RipTextXY(x0,y0 : word; instr : string);
- begin
- rTextXY(x0,y0,instr);
- sendstrcr('!|@'+wordtomega(x0)+wordtomega(y0)+escapestring(instr));
- end;
-
- Procedure RipObj.RipFontStyle(font,direct,size : byte);
- begin
- rFontStyle(font,direct,size);
- sendstrcr('!|Y'+wordtomega(font)+wordtomega(direct)+wordtomega(size)+'00');
- end;
-
- Procedure RipObj.RipPixel(x0,y0 : word);
- begin
- rPixel(x0,y0);
- sendstrcr('!|X'+wordtomega(x0)+wordtomega(y0));
- end;
-
- Procedure RipObj.RipLine(x0,y0,x1,y1 : word);
- begin
- rLine(x0,y0,x1,y1);
- sendstrcr('!|L'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1));
- end;
-
- Procedure RipObj.RipRectangle(x0,y0,x1,y1 : word);
- begin
- rRectangle(x0,y0,x1,y1);
- sendstrcr('!|R'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1));
- end;
-
- Procedure RipObj.RipBar(x0,y0,x1,y1 : word);
- begin
- rBar(x0,y0,x1,y1);
- sendstrcr('!|B'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1));
- end;
-
- Procedure RipObj.RipCircle(x0,y0,radius : word);
- begin
- rCircle(x0,y0,radius);
- sendstrcr('!|C'+wordtomega(x0)+wordtomega(y0)+wordtomega(radius));
- end;
-
- Procedure RipObj.RipOval(x0,y0,StAngle,EndAngle,xrad,yrad : word);
- begin
- rOval(x0,y0,stangle,endangle,xrad,yrad);
- sendstrcr('!|O'+wordtomega(x0)+wordtomega(y0)+wordtomega(stangle)+wordtomega(endangle)+wordtomega(xrad)+wordtomega(yrad));
- end;
-
- Procedure RipObj.RipFilledOval(x0,y0,xrad,yrad : word);
- begin
- rFilledOval(x0,y0,xrad,yrad);
- sendstrcr('!|o'+wordtomega(x0)+wordtomega(y0)+wordtomega(xrad)+wordtomega(yrad));
- end;
-
- Procedure RipObj.RipArc(x0,y0,StAngle,EndAngle,Rad : word);
- begin
- rArc(x0,y0,stangle,endangle,rad);
- sendstrcr('!|A'+wordtomega(x0)+wordtomega(y0)+wordtomega(stangle)+wordtomega(endangle)+wordtomega(rad));
- end;
-
- Procedure RipObj.RipOvalArc(x0,y0,StAngle,EndAngle,xrad,yrad : word);
- begin
- rOval(x0,y0,stangle,endangle,xrad,yrad);
- sendstrcr('!|V'+wordtomega(x0)+wordtomega(y0)+wordtomega(stangle)+wordtomega(endangle)+wordtomega(xrad)+wordtomega(yrad));
- end;
-
- Procedure RipObj.RipPieSlice(x0,y0,StAngle,EndAngle,Rad : word);
- begin
- rPieSlice(x0,y0,stangle,endangle,rad);
- sendstrcr('!|I'+wordtomega(x0)+wordtomega(y0)+wordtomega(stangle)+wordtomega(endangle)+wordtomega(rad));
- end;
-
- Procedure RipObj.RipOvalPieSlice(x0,y0,StAngle,EndAngle,radx,rady : word);
- begin
- rOvalPieSlice(x0,y0,stangle,endangle,radx,rady);
- sendstrcr('!|i'+wordtomega(x0)+wordtomega(y0)+wordtomega(stangle)+wordtomega(endangle)+wordtomega(radx)+wordtomega(rady));
- end;
-
- Procedure RipObj.RipBezier(x0,y0,x1,y1,x2,y2,x3,y3,count : word);
- begin
- rBezier(x0,y0,x1,y1,x2,y2,x3,y3,count);
- sendstrcr('!|Z'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1)+
- wordtomega(x2)+wordtomega(y2)+wordtomega(x3)+wordtomega(y3));
- end;
-
- Procedure RipObj.RipPolygon(NumPoints : word; var PolyPoints);
- type
- PointRec = record
- X : word;
- Y : word;
- end;
-
- TempType = Array[1..512] of PointRec;
- var
- TempVar : TempType;
- TempStr : string;
- ctr : word;
- begin
- rPolygon(numpoints,polypoints,true);
-
- TempVar := TempType(PolyPoints);
- tempstr := '';
- for ctr := 1 to numpoints do
- tempstr := tempstr + wordtomega(TempVar[ctr].X) + wordtomega(TempVar[ctr].Y);
- sendstrcr('!|P'+wordtomega(numpoints)+tempstr);
- end;
-
- Procedure RipObj.RipFillPoly(NumPoints : word; var polypoints);
- type
- PointRec = record
- X : word;
- Y : word;
- end;
-
- TempType = Array[1..512] of PointRec;
- var
- TempVar : TempType;
- TempStr : string;
- ctr : word;
- begin
- rFillPoly(numpoints,polypoints);
-
- TempVar := TempType(PolyPoints);
- tempstr := '';
- for ctr := 1 to numpoints do
- tempstr := tempstr + wordtomega(TempVar[ctr].X) + wordtomega(TempVar[ctr].Y);
- sendstrcr('!|p'+wordtomega(numpoints)+tempstr);
- end;
-
- Procedure RipObj.RipPolyLine(NumPoints : word; var polypoints);
- type
- PointRec = record
- X : word;
- Y : word;
- end;
-
- TempType = Array[1..512] of PointRec;
- var
- TempVar : TempType;
- TempStr : string;
- ctr : word;
- begin
- rPolygon(numpoints,polypoints,false);
-
- TempVar := TempType(PolyPoints);
- tempstr := '';
- for ctr := 1 to numpoints do
- tempstr := tempstr + wordtomega(TempVar[ctr].X) + wordtomega(TempVar[ctr].Y);
- sendstrcr('!|l'+wordtomega(numpoints)+tempstr);
- end;
-
- Procedure RipObj.RipFill(x0,y0,border : word);
- begin
- rFill(x0,y0,border);
- sendstrcr('!|F'+wordtomega(x0)+wordtomega(y0)+wordtomega(border));
- end;
-
- Procedure RipObj.RipLineStyle(style, pattern, thick : word);
- begin
- rLineStyle(style,pattern,thick);
- sendstrcr('!|='+wordtomega(style)+wordtomega4(pattern)+wordtomega(thick));
- end;
-
- Procedure RipObj.RipFillStyle(style, color : word);
- begin
- rFillStyle(style,color);
- sendstrcr('!|S'+wordtomega(style)+wordtomega(color));
- end;
-
- Procedure RipObj.RipFillPattern(Pattern : fpt; color : word);
- begin
- rFillPattern(pattern,color);
- sendstrcr('!|s'+wordtomega(pattern[1])+wordtomega(pattern[2])+wordtomega(pattern[3])+wordtomega(pattern[4])+
- wordtomega(pattern[5])+wordtomega(pattern[6])+wordtomega(pattern[7])+wordtomega(pattern[8])+wordtomega(color));
- end;
-
- Procedure RipObj.RipMouse(x0,y0,x1,y1 : word; click, clear : boolean; instr : string);
- var
- ch1, ch2 : char;
- begin
- if click then
- ch1 := '1'
- else
- ch1 := '0';
- if clear then
- ch2 := '1'
- else
- ch2 := '0';
- rMouse(x0,y0,x1,y1,click,clear,instr);
- sendstrcr('!|1M00'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1)+ch1+ch2+'00000'+escapestring(instr));
- end;
-
- Procedure RipObj.RipKillMouseFields;
- begin
- rKillMouse;
- sendstrcr('!|1K');
- end;
-
- Procedure RipObj.RipBeginText(x0,y0,x1,y1 : word);
- begin
- sendstrcr('!|1T'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1));
- end;
-
- Procedure RipObj.RipRegionText(justify : boolean; instr : string);
- var
- tch : char;
- begin
- if justify then
- tch := '1'
- else
- tch := '0';
- sendstrcr('!|1t'+tch+escapestring(instr));
- end;
-
- Procedure RipObj.RipEndText;
- begin
- sendstrcr('!|1E');
- end;
-
- Procedure RipObj.RipGetImage(x0,y0,x1,y1 : word);
- begin
- rGetImage(x0,y0,x1,y1);
- sendstrcr('!|1C'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1)+'0');
- end;
-
- Procedure RipObj.RipPutImage(x0,y0,mode : word);
- begin
- rPutImage(x0,y0,mode);
- sendstrcr('!|1P'+wordtomega(x0)+wordtomega(y0)+wordtomega(mode)+'0');
- end;
-
- Procedure RipObj.RipWriteIcon(fname : str12);
- begin
- rWriteIcon(fname);
- sendstrcr('!|1W0'+escapestring(fname));
- end;
-
- Procedure RipObj.RipLoadIcon(x0,y0,mode : word; clipbrd : boolean; fname : str12);
- var
- tch : char;
- begin
- rLoadIcon(x0,y0,mode,clipbrd,fname);
- if clipbrd then
- tch := '1'
- else
- tch := '0';
- sendstrcr('!|1I'+wordtomega(x0)+wordtomega(y0)+wordtomega(mode)+tch+'10'+escapestring(fname));
- end;
-
- Procedure RipObj.RipButtonStyle(wid,hgt,orient,flags,bevsize,dfore,dback,bright,dark,
- surface,grp_no,flags2,uline_col,corner_col : word);
- begin
- rButtonStyle(wid,hgt,orient,flags,bevsize,dfore,dback,bright,dark,surface,grp_no,flags2,uline_col,corner_col);
- sendstrcr('!|1B'+wordtomega(wid)+wordtomega(hgt)+wordtomega(orient)+wordtomega4(flags)+wordtomega(bevsize)+
- wordtomega(dfore)+wordtomega(dback)+wordtomega(bright)+wordtomega(dark)+wordtomega(surface)+
- wordtomega(grp_no)+wordtomega(flags2)+wordtomega(uline_col)+wordtomega(corner_col)+'000000');
- end;
-
- Procedure RipObj.RipButton(x0,y0,x1,y1,hotkey : word; flags : byte; icon : str12; sLabel : string; Cmd : string);
- var
- flgch : char;
- begin
- rButton(x0,y0,x1,y1,hotkey,flags,icon,slabel,cmd);
- case flags of
- 0 : flgch := '0';
- 1 : flgch := '1';
- 2 : flgch := '2';
- else
- flgch := '0';
- end;
- sendstrcr('!|1U'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1)+
- wordtomega(hotkey)+flgch+'0'+escapestring(icon)+
- '<>'+escapestring(sLabel)+'<>'+escapestring(cmd));
- end;
-
- Procedure RipObj.RipDefine(flags : word; textvar : str12; width : byte; ques, default : string);
- begin
- sendstrcr('!|1D0'+wordtomega(flags)+'00'+escapestring(textvar)+','+inttostr(width)+
- ':?'+escapestring(ques)+'?'+escapestring(default));
- end;
-
- Procedure RipObj.RipQuery(mode : byte; instr : string);
- var
- mch : char;
- begin
- case mode of
- 0 : mch := '0';
- 1 : mch := '1';
- 2 : mch := '2';
- else
- mch := '0';
- end;
- sendstrcr('!|1'+#27+mch+'000'+escapestring(instr));
- end;
-
- Procedure RipObj.RipCopyRegion(x0,y0,x1,y1,destline : word);
- begin
- sendstrcr('!|1G'+wordtomega(x0)+wordtomega(y0)+wordtomega(x1)+wordtomega(y1)+'00'+wordtomega(destline));
- end;
-
- Procedure RipObj.RipReadScene(fname : str12);
- begin
- sendstrcr('!|1R00000000'+escapestring(fname));
- end;
-
- Procedure RipObj.RipFileQuery(mode : word; fname : str12);
- begin
- sendstrcr('!|1F'+wordtomega(mode)+'0000'+escapestring(fname));
- end;
-
- Procedure RipObj.RipEnterBlockMode(ul : boolean; proto,ftype : word; fname : str12);
- var
- bstr : string;
- wtemp,bch: char;
- begin
- if ul then
- wtemp := '1'
- else
- wtemp := '0';
- bstr := wordtomega(proto);
- bch := bstr[2];
- sendstrcr('!|0'+#27+wtemp+bch+wordtomega(ftype)+'0000'+escapestring(fname)+'<>');
- end;
-
- Procedure RipObj.RipNoMore;
- begin
- sendstrcr('!|#|#|#');
- end;
-
- Procedure RipObj.SendStr(instr : string);
- begin
- runerror(211);
- end;
-
- Procedure RipObj.SendStrCR(instr : string);
- begin
- SendStr(instr+#13#10);
- end;
-
- Procedure RipObj.StatLine;
- var
- vpt : ViewPortType;
- tst : TextSettingsType;
- lst : LineSettingsType;
- col : word; {color}
- begin
- if LocalRip then
- begin
- GetViewSettings(vpt);
- GetTextSettings(tst);
- GetLineSettings(lst);
- Col := GetColor;
- SetColor(0);
-
- SetViewPort(0,GetMaxY-12,GetMaxX,GetMaxY,true);
- SetTextStyle(defaultfont,horizdir,1);
- SetLineStyle(SolidLn,0,NormWidth);
- SetTextJustify(LeftText,TopText);
- ClearViewPort;
- SetColor(9);
- Rectangle(0,0,GetMaxX,11);
- SetColor(11);
- OutTextXY(3,3,StatText);
- SetColor(col);
- with vpt do
- SetViewPort(x1,y1,x2,y2,clip);
- with tst do
- begin
- SetTextStyle(font,direction,charsize);
- SetTextJustify(Horiz,Vert);
- end;
- with lst do
- SetLineStyle(LineStyle,Pattern,Thickness);
- end;
- end;
-
- Function RipObj.DisplayRIPfile(Path : string): boolean;
- var
- ctr : word;
- FName : String;
- F : file;
- FBuf : Array [0..1023] of Char;
- BufRead : Word;
- BufCnt : Word;
- sBuf : string;
- begin
- displayripfile := false;
- sbuf := '';
- {if exists(Path) then}
- FName := Path
- {else
- Exit};
- filemode := $20;
- Assign(F,FName);
- {$I-}
- Reset(F,1);
- {$I+}
- if ioresult <> 0 then
- begin
- exit;
- end;
- displayripfile := true;
- While not EOF(F) do
- begin
- fillchar(FBuf,1024,#0);
- BlockRead(F,FBuf,1024,BufRead);
- For BufCnt := 0 to BufRead-1 do
- begin
- ParseRip(fbuf[bufcnt],false);
- if FBuf[BufCnt] <> #0 then
- sBuf := sBuf + FBuf[BufCnt];
- if length(sbuf) > 10 then
- begin
- sendstr(sbuf);
- sbuf := '';
- end;
- end;
- end;
- sendstr(sbuf);
- Close(F);
- end;
-
- Procedure RipObj.ResetParser;
- begin
- fillchar(rbuffer,1024,#0);
- bufcount := 0;
- level := 0;
- sublevel := 0;
- command := #0;
- {lastc := #0;}
- firstcmd := false;
- if nextcommand then
- pstat := got_pipe
- else
- pstat := none;
- lstat := lNone;
- nextcommand := false;
- commanddone := false;
- cstat := cnone;
- end;
-
- Procedure RipObj.ResetParser2(c:char);
- begin
- ResetParser;
- inc(bufcount);
- rbuffer[bufcount] := c;
- if c = #13 then
- begin
- firstcmd := true;
- dec(bufcount);
- end;
- end;
-
- Procedure RipObj.DumpBuffer;
- var
- ctr : word;
- begin
- for ctr := 1 to bufcount do
- DoTextChar(rbuffer[ctr]);
- resetparser;
- end;
-
- Procedure RipObj.DumpBuffer2;
- var
- stor:boolean;
- begin
- stor := firstcmd;
- ResetParser;
- firstcmd := stor;
- end;
-
- Procedure RipObj.ParseRipStr(s:string;sendchar:boolean);
- var
- ctr : byte;
- begin
- for ctr := 1 to length(s) do
- ParseRip(s[ctr],sendchar);
- end;
-
- Procedure RipObj.ParseRip(c : char;sendchar : boolean);
- var
- ctr : word;
- b : boolean;
- begin
- if sendchar then
- sendstr(c);
- b := DoRipChar(c);
- end;
-
- Function RipObj.MegaBuf(tpos,a,b:byte):word;
- begin
- megabuf := megatoword(rbuffer[tpos+a]+rbuffer[tpos+b]);
- end;
-
- Function RipObj.UnEscapeString(bStart,bEnd:word):string;
- var
- s : string;
- ctr : byte;
- begin
- s := '';
- ctr := bStart-1;
- while ctr < bEnd-1 do
- begin
- inc(ctr);
- if rbuffer[ctr] = '\' then
- begin
- inc(ctr);
- if rbuffer[ctr] in ['\','|','!'] then
- s := s + rbuffer[ctr]
- else
- while rbuffer[ctr+1] in [#13,#10] do
- inc(ctr);
- end
- else
- s := s + rbuffer[ctr];
- end;
- unescapestring := s;
- end;
-
- Function RipObj.DoRipChar(c : char): boolean;
- type
- PointRec = record
- X : word;
- Y : word;
- end;
-
- TempType = Array[1..512] of PointRec;
- var
- doexit : boolean;
- st5 : string[7];
- tPos : byte;
- st2 : string[2];
- w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13,w14,w15,w16 : word;
- b1,b2,b3,b4,b5 : byte;
- o1,o2 : boolean;
- s1,s2,s3,s4 : string;
- sCtr : byte;
- TempPoly : TempType;
- TempFPT : fpt;
-
- Function MegaB(ch:char) :Boolean;
- begin
- if ch = '1' then
- megab := true
- else
- megab := false;
- end;
-
- Procedure DoTheButton;
- var
- sctr : byte;
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- s1 := ''; s2 := ''; s3 := ''; s4 := '';
- s1 := unescapestring(tpos+13,bufcount);
- case pos('<>',s1) of
- 0 : begin
- if s1 <> '' then
- begin
- s2 := s1;
- s1 := '';
- end;
- end;
- 1 : delete(s1,1{index},2{count});
- else
- begin
- s2 := copy(s1,1,pos('<>',s1)-1);
- delete(s1,1,pos('<>',s1)+1);
- end;
- end;
- case pos('<>',s1) of
- 0 : begin
- if s1 <> '' then
- begin
- s3 := s1;
- s1 := '';
- end;
- end;
- 1 : delete(s1,1{index},2{count});
- else
- begin
- s3 := copy(s1,1,pos('<>',s1)-1);
- delete(s1,1,pos('<>',s1)+1);
- end;
- end;
- case pos('<>',s1) of
- 0 : begin
- if s1 <> '' then
- begin
- s4 := s1;
- s1 := '';
- end;
- end;
- 1 : delete(s1,1{index},2{count});
- else
- begin
- s4 := copy(s1,1,pos('<>',s1)-1);
- delete(s1,1,pos('<>',s1)+1);
- end;
- end;
-
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- w5 := megabuf(tpos,9,10);
- b1 := megatoword('0'+rbuffer[tpos+11]);
- rButton(w1,w2,w3,w4,w5,b1,s2,s3,s4);
- {$IFDEF DEBUGIT}
- writeln(log,'Button: ',w1,',',w2,',',w3,',',w4,',',w5,',',b1,',',s2,',',s3,',',s4);
- {$ENDIF}
- end;
-
- Procedure DoTheButtonStyle;
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := word(mega4tolong(rbuffer[tpos+7]+rbuffer[tpos+8]+rbuffer[tpos+9]+rbuffer[tpos+10]));
- w5 := megabuf(tpos,11,12);
- w6 := megabuf(tpos,13,14);
- w7 := megabuf(tpos,15,16);
- w8 := megabuf(tpos,17,18);
- w9 := megabuf(tpos,19,20);
- w10 := megabuf(tpos,21,22);
- w11 := megabuf(tpos,23,24);
- w12 := megabuf(tpos,25,26);
- w13 := megabuf(tpos,27,28);
- w14 := megabuf(tpos,29,30);
- rButtonStyle(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13,w14);
- {$IFDEF DEBUGIT}
- write(log,'Button Style: ',w1,',',w2,',',w3,',',w4,',',w5,',',w6,',',w7,',',w8);
- writeln(log,',',w9,',',w10,',',w11,',',w12,',',w13,',',w14);
- {$ENDIF}
- end;
-
- Procedure DoSetPalette;
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1 ,2 );
- w2 := megabuf(tpos,3 ,4 );
- w3 := megabuf(tpos,5 ,6 );
- w4 := megabuf(tpos,7 ,8 );
- w5 := megabuf(tpos,9 ,10);
- w6 := megabuf(tpos,11,12);
- w7 := megabuf(tpos,13,14);
- w8 := megabuf(tpos,15,16);
- w9 := megabuf(tpos,17,18);
- w10 := megabuf(tpos,19,20);
- w11 := megabuf(tpos,21,22);
- w12 := megabuf(tpos,23,24);
- w13 := megabuf(tpos,25,26);
- w14 := megabuf(tpos,27,28);
- w15 := megabuf(tpos,29,30);
- w16 := megabuf(tpos,31,32);
- rSetPalette(w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13,w14,w15,w16);
- {$IFDEF DEBUGIT}
- write(log,'Set Palette: ',w1,',',w2,',',w3,',',w4,',',w5,',',w6,',',w7,',',w8);
- writeln(log,',',w9,',',w10,',',w11,',',w12,',',w13,',',w14,',',w15,',',w16);
- {$ENDIF}
- end;
-
- Procedure DoFillPattern;
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- tempfpt[1] := megabuf(tpos,1,2);
- tempfpt[2] := megabuf(tpos,3,4);
- tempfpt[3] := megabuf(tpos,5,6);
- tempfpt[4] := megabuf(tpos,7,8);
- tempfpt[5] := megabuf(tpos,9,10);
- tempfpt[6] := megabuf(tpos,11,12);
- tempfpt[7] := megabuf(tpos,13,14);
- tempfpt[8] := megabuf(tpos,15,16);
- w1 := megabuf(tpos,17,18);
- rFillpattern(tempfpt,w1);
- {$IFDEF DEBUGIT}
- write(log,'Fill Pattern: ',tempfpt[1],',',tempfpt[2],',');
- write(log,tempfpt[3],',',tempfpt[4],',',tempfpt[5],',',tempfpt[6],',');
- writeln(log,tempfpt[7],',',tempfpt[8],',',w1);
- {$ENDIF}
- end;
-
- begin
- doripchar := false;
-
- inc(bufcount);
- rbuffer[bufcount] := c;
-
- doexit := false;
-
- if c in [#13,#10,'!'] then
- begin
- if (c = #13) and (lstat <> lBackSlash) then
- begin
- firstcmd := true;
- end;
- if (not didrip) and (c = '!') and (lastc = #10) then
- firstcmd := true;
- end
- else
- firstcmd := false;
-
- lastc := c;
-
- case pstat of
- None : begin
- if firstcmd then
- begin
- if c = '!' then
- pstat := got_excl
- else
- begin
- if not (c in [#13,#10]) then
- dumpbuffer
- else
- if didrip then
- begin
- dec(bufcount);
- if c = #10 then
- didrip := false;
- end
- else
- dumpbuffer;
- exit;
- end;
- end
- else
- if c in [#1,#2] then
- pstat := got_excl
- else
- if c = '|' then
- pstat := got_pipe
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- Got_Excl : begin
- didrip := true;
- if c = '|' then
- pstat := got_pipe
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- Got_Pipe : begin
- didrip := true;
- case c of
- '1'..'9' : begin
- level := strtoint(c);
- pstat := got_level;
- end;
- #27,'#','*','=','>','@','A'..'Z','a'..'z' :
- begin
- level := 0;
- command := c;
- pstat := got_command;
- end;
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- end;
- Got_Level : begin
- case c of
- '1'..'9' : begin
- sublevel := strtoint(c);
- pstat := got_sublevel;
- end;
- #27,'#','*','=','>','@','A'..'Z','a'..'z' :
- begin
- command := c;
- pstat := got_command;
- end;
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- end;
- Got_SubLevel : begin
- if c in [#27,'#','*','=','>','@','A'..'Z','a'..'z'] then
- begin
- command := c;
- pstat := got_command;
- end
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- Got_Command : begin
- if (c = '|') and not (lstat = lBackSlash) then
- nextcommand := true;
-
- case c of
- #13 : lstat := lCR;
- #10 : lstat := lLF;
- '|' : lstat := lPipe;
- '\' : lstat := lBackSlash;
- '!' : lstat := lExcl;
- else
- lstat := lChar;
- end;
-
- if firstcmd {and (cstat <> contline) and (cstat <> pending)} then
- doexit := true;
- { case cstat of
- pending : begin
- if c = #13 then
- cstat := contline
- else
- cstat := escaped;
- end;
- contline : cstat := cnone;
- end;}
- st5 := rbuffer[1]+rbuffer[2]+rbuffer[3]+rbuffer[4]+rbuffer[5]+rbuffer[6]+rbuffer[7];
- tpos := pos(command,st5);
- case level of
- 0 : begin
- case command of
- 'w' : begin {text window}
- if bufcount = (tpos+10) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- b1 := megabuf(tpos,1,2);
- b2 := megabuf(tpos,3,4);
- b3 := megabuf(tpos,5,6);
- b4 := megabuf(tpos,7,8);
- b5 := megatoword('0'+rbuffer[tpos+10]);
- o1 := megab(rbuffer[tpos+9]);
- rTextWindow(b1,b2,b3,b4,o1,b5);
- {$IFDEF DEBUGIT}
- writeln(log,'Text Window: ',b1,',',b2,',',b3,',',b4,',',o1,',',b5);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'v' : begin {view port}
- if bufcount = (tpos+ 8) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- rViewPort(w1,w2,w3,w4);
- {$IFDEF DEBUGIT}
- writeln(log,'View Port: ',w1,',',w2,',',w3,',',w4);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- '*' : begin {reset windows}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- rResetWindows;
- {$IFDEF DEBUGIT}
- writeln(log,'Reset Windows');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- 'e' : begin {erase window}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- rEraseWindow;
- {$IFDEF DEBUGIT}
- writeln(log,'Erase Window');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- 'E' : begin {erase view}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- rEraseView;
- {$IFDEF DEBUGIT}
- writeln(log,'Erase View');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- 'g' : begin {gotoxy}
- if bufcount = (tpos+ 4) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- b1 := megabuf(tpos,1,2);
- b2 := megabuf(tpos,3,4);
- rGotoXY(b1,b2);
- {$IFDEF DEBUGIT}
- writeln(log,'GotoXY: ',b1,',',b2);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'H' : begin {home}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- rHome;
- {$IFDEF DEBUGIT}
- writeln(log,'Home');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- '>' : begin {erase eol}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- rEraseEOL;
- {$IFDEF DEBUGIT}
- writeln(log,'EraseEOL');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- 'c' : begin {color}
- if bufcount = (tpos+ 2) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- b1 := megabuf(tpos,1,2);
- rColor(b1);
- {$IFDEF DEBUGIT}
- writeln(log,'Color: ',b1);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'Q' : begin {set palette}
- if bufcount = (tpos+ 32) then
- begin
- DoSetPalette;
- resetparser;
- exit;
- end;
- end;
- 'a' : begin {one palette}
- if bufcount = (tpos+ 4) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- rOnePalette(w1,w2);
- {$IFDEF DEBUGIT}
- writeln(log,'One Palette: ',w1,',',w2);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'W' : begin {write mode}
- if bufcount = (tpos+ 2) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- b1 := megabuf(tpos,1,2);
- rWriteMode(b1);
- {$IFDEF DEBUGIT}
- writeln(log,'Write Mode: ',b1);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'm' : begin {move}
- if bufcount = (tpos+ 4) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- rMove(w1,w2);
- {$IFDEF DEBUGIT}
- writeln(log,'Move: ',w1,',',w2);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'T' : begin {text}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- s1 := unescapestring(tpos+1,bufcount);
- rText(s1);
- {$IFDEF DEBUGIT}
- writeln(log,'Text: ',s1);
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- '@' : begin {textxy}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- s1 := unescapestring(tpos+5,bufcount);
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- rTextXY(w1,w2,s1);
- {$IFDEF DEBUGIT}
- writeln(log,'TextXY: ',w1,',',w2,',',s1);
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- 'Y' : begin {font style}
- if bufcount = (tpos+ 8) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- b1 := megabuf(tpos,1,2);
- b2 := megabuf(tpos,3,4);
- b3 := megabuf(tpos,5,6);
- rFontStyle(b1,b2,b3);
- {$IFDEF DEBUGIT}
- writeln(log,'Font Style: ',b1,',',b2,',',b3);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'X' : begin {pixel}
- if bufcount = (tpos+ 4) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- rPixel(w1,w2);
- {$IFDEF DEBUGIT}
- writeln(log,'Pixel: ',w1,',',w2);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'L' : begin {line}
- if bufcount = (tpos+ 8) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- rLine(w1,w2,w3,w4);
- {$IFDEF DEBUGIT}
- writeln(log,'Line: ',w1,',',w2,',',w3,',',w4);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'R' : begin {rectangle}
- if bufcount = (tpos+ 8) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- rRectangle(w1,w2,w3,w4);
- {$IFDEF DEBUGIT}
- writeln(log,'Rectangle: ',w1,',',w2,',',w3,',',w4);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'B' : begin {bar}
- if bufcount = (tpos+ 8) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- rBar(w1,w2,w3,w4);
- {$IFDEF DEBUGIT}
- writeln(log,'Bar: ',w1,',',w2,',',w3,',',w4);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'C' : begin {circle}
- if bufcount = (tpos+ 6) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- rCircle(w1,w2,w3);
- {$IFDEF DEBUGIT}
- writeln(log,'Circle: ',w1,',',w2,',',w3);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'O' : begin {oval}
- if bufcount = (tpos+ 12) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- w5 := megabuf(tpos,9,10);
- w6 := megabuf(tpos,11,12);
- rOval(w1,w2,w3,w4,w5,w6);
- {$IFDEF DEBUGIT}
- writeln(log,'Oval: ',w1,',',w2,',',w3,',',w4,',',w5,',',w6);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'o' : begin {filled oval}
- if bufcount = (tpos+ 8) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- rFilledOval(w1,w2,w3,w4);
- {$IFDEF DEBUGIT}
- writeln(log,'Filled Oval: ',w1,',',w2,',',w3,',',w4);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'A' : begin {arc}
- if bufcount = (tpos+ 10) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- w5 := megabuf(tpos,9,10);
- rArc(w1,w2,w3,w4,w5);
- {$IFDEF DEBUGIT}
- writeln(log,'Arc: ',w1,',',w2,',',w3,',',w4,',',w5);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'V' : begin {oval arc}
- if bufcount = (tpos+ 12) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- w5 := megabuf(tpos,9,10);
- w6 := megabuf(tpos,11,12);
- rOval(w1,w2,w3,w4,w5,w6);
- {$IFDEF DEBUGIT}
- writeln(log,'Oval Arc: ',w1,',',w2,',',w3,',',w4,',',w5,',',w6);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'I' : begin {pie slice}
- if bufcount = (tpos+ 10) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- w5 := megabuf(tpos,9,10);
- rPieSlice(w1,w2,w3,w4,w5);
- {$IFDEF DEBUGIT}
- writeln(log,'Pie Slice: ',w1,',',w2,',',w3,',',w4,',',w5);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'i' : begin {oval pie slice}
- if bufcount = (tpos+ 12) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- w5 := megabuf(tpos,9,10);
- w6 := megabuf(tpos,11,12);
- rOvalPieSlice(w1,w2,w3,w4,w5,w6);
- {$IFDEF DEBUGIT}
- writeln(log,'Oval Pie Slice: ',w1,',',w2,',',w3,',',w4,',',w5,',',w6);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'Z' : begin {bezier}
- if bufcount = (tpos+ 18) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- w5 := megabuf(tpos,9,10);
- w6 := megabuf(tpos,11,12);
- w7 := megabuf(tpos,13,14);
- w8 := megabuf(tpos,15,16);
- w9 := megabuf(tpos,17,18);
- rBezier(w1,w2,w3,w4,w5,w6,w7,w8,w9);
- {$IFDEF DEBUGIT}
- writeln(log,'Bezier: ',w1,',',w2,',',w3,',',w4,',',w5,',',w6,',',w7,',',w8,',',w9);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'P' : begin {polygon}
- if bufcount >= (tpos+ 2) then
- begin
- st2 := rbuffer[tpos+1]+rbuffer[tpos+2];
- if bufcount = (tpos+2+ (4* megatoword(st2))) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- fillchar(temppoly,2048,#0);
- w1 := megatoword(st2);
- for sctr := 1 to w1 do
- begin
- temppoly[sctr].X := megabuf(tpos,3+((sctr-1)*4),4+((sctr-1)*4));
- temppoly[sctr].Y := megabuf(tpos,5+((sctr-1)*4),6+((sctr-1)*4));
- end;
- rPolygon(w1,temppoly,true);
- {$IFDEF DEBUGIT}
- write(log,'Polygon: ',w1,',');
- for sctr := 1 to w1 do
- write(log,temppoly[sctr].X,',',temppoly[sctr].Y,',');
- writeln(log);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- end;
- 'p' : begin {fill polygon}
- if bufcount >= (tpos+ 2) then
- begin
- st2 := rbuffer[tpos+1]+rbuffer[tpos+2];
- if bufcount = (tpos+2+ (4* megatoword(st2))) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- fillchar(temppoly,2048,#0);
- w1 := megatoword(st2);
- for sctr := 1 to w1 do
- begin
- temppoly[sctr].X := megabuf(tpos,3+((sctr-1)*4),4+((sctr-1)*4));
- temppoly[sctr].Y := megabuf(tpos,5+((sctr-1)*4),6+((sctr-1)*4));
- end;
- rFillPoly(w1,temppoly);
- {$IFDEF DEBUGIT}
- write(log,'Fill Polygon: ',w1,',');
- for sctr := 1 to w1 do
- write(log,temppoly[sctr].X,',',temppoly[sctr].Y,',');
- writeln(log);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- end;
- 'l' : begin {polyline}
- if bufcount >= (tpos+ 2) then
- begin
- st2 := rbuffer[tpos+1]+rbuffer[tpos+2];
- if bufcount = (tpos+2+ (4* megatoword(st2))) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- fillchar(temppoly,2048,#0);
- w1 := megatoword(st2);
- for sctr := 1 to w1 do
- begin
- temppoly[sctr].X := megabuf(tpos,3+((sctr-1)*4),4+((sctr-1)*4));
- temppoly[sctr].Y := megabuf(tpos,5+((sctr-1)*4),6+((sctr-1)*4));
- end;
- rPolygon(w1,temppoly,false);
- {$IFDEF DEBUGIT}
- write(log,'PolyLine: ',w1,',');
- for sctr := 1 to w1 to
- write(log,temppoly[sctr].X,',',temppoly[sctr].Y,',');
- writeln(log);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- end;
- 'F' : begin {fill}
- if bufcount = (tpos+ 6) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- rFill(w1,w2,w3);
- {$IFDEF DEBUGIT}
- writeln(log,'Fill: ',w1,',',w2,',',w3);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- '=' : begin {line style}
- if bufcount = (tpos+ 8) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := word(mega4tolong(rbuffer[tpos+3]+rbuffer[tpos+4]
- +rbuffer[tpos+5]+rbuffer[tpos+6]));
- w3 := megabuf(tpos,7,8);
- rLineStyle(w1,w2,w3);
- {$IFDEF DEBUGIT}
- writeln(log,'Line Style: ',w1,',',w2,',',w3);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'S' : begin {fill style}
- if bufcount = (tpos+ 4) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- rFillStyle(w1,w2);
- {$IFDEF DEBUGIT}
- writeln(log,'Fill Style: ',w1,',',w2);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 's' : begin {fill pattern}
- if bufcount = (tpos+ 18) then
- begin
- DoFillPattern;
- resetparser;
- exit;
- end;
- end;
- '#' : begin {no more}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'No More');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- end;
- 1 : begin
- case command of
- 'M' : begin {mouse}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- s1 := unescapestring(tpos+18,bufcount);
- w1 := megabuf(tpos,3,4);
- w2 := megabuf(tpos,5,6);
- w3 := megabuf(tpos,7,8);
- w4 := megabuf(tpos,9,10);
- o1 := megab(rbuffer[tpos+11]);
- o2 := megab(rbuffer[tpos+12]);
- rMouse(w1,w2,w3,w4,o1,o2,s1);
- {$IFDEF DEBUGIT}
- writeln(log,'Mouse: ',w1,',',w2,',',w3,',',w4,',',o1,',',o2,',',s1);
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- 'K' : begin {kill mouse fields}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- rKillMouse;
- {$IFDEF DEBUGIT}
- writeln(log,'Kill Mouse Fields');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- 'T' : begin {begin text}
- if bufcount = (tpos+ 10) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'Begin Text: x');
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 't' : begin {region text}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'Region Text: x');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- 'E' : begin {end text}
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'End Text');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- 'C' : begin {get image}
- if bufcount = (tpos+ 9) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- w4 := megabuf(tpos,7,8);
- rGetImage(w1,w2,w3,w4);
- {$IFDEF DEBUGIT}
- writeln(log,'Get Image: ',w1,',',w2,',',w3,',',w4);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'P' : begin {put image}
- if bufcount = (tpos+ 7) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- rPutImage(w1,w2,w3);
- {$IFDEF DEBUGIT}
- writeln(log,'Put Image: ',w1,',',w2,',',w3);
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'W' : begin {write icon}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- s1 := unescapestring(tpos+2,bufcount);
- rWriteIcon(s1);
- {$IFDEF DEBUGIT}
- writeln(log,'Write Icon: ',s1);
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- 'I' : begin {load icon}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- s1 := unescapestring(tpos+10,bufcount);
- w1 := megabuf(tpos,1,2);
- w2 := megabuf(tpos,3,4);
- w3 := megabuf(tpos,5,6);
- o1 := megab(rbuffer[tpos+7]);
- rLoadIcon(w1,w2,w3,o1,s1);
- {$IFDEF DEBUGIT}
- writeln(log,'Load Icon: ',w1,',',w2,',',w3,',',o1,',',s1);
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- 'B' : begin {button style}
- if bufcount = (tpos+ 36) then
- begin
- DoTheButtonStyle;
- resetparser;
- exit;
- end;
- end;
- 'U' : begin {button}
- if doexit or nextcommand then
- begin
- DoTheButton;
- resetparser2(c);
- exit;
- end;
- end;
- 'D' : begin {define}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'Define: x');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- #27 : begin {query}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'Query: x');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- 'G' : begin {copy region}
- if bufcount = (tpos+ 12) then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'Copy Region: x');
- {$ENDIF}
- resetparser;
- exit;
- end;
- end;
- 'R' : begin {read scene}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'Read Scene: x');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- 'F' : begin {file query}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'File Query: x');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- end;
- 9 : begin
- case command of
- #27 : begin {enter block mode}
- if doexit or nextcommand then
- begin
- {$IFDEF DEBUGPAUSE}
- readkey;
- {$ENDIF}
- {$IFDEF DEBUGIT}
- writeln(log,'Block Mode: x');
- {$ENDIF}
- resetparser2(c);
- exit;
- end;
- end;
- else
- begin
- dumpbuffer;
- exit;
- end;
- end;
- end;
- else {case}
- begin
- dumpbuffer;
- exit;
- end;
- end; {case level of}
- if doexit then
- exit;
- end; {got_command}
- end;
- doripchar := true;
- end;
-
- {$IFDEF MOUSE}
- Procedure RipObj.MouseInit;
- begin
- regs.ax := $0000;
- intr($33,regs);
- mouseexist := (regs.ax = $ffff);
- ismouseon := false;
- fillchar(regionarray,sizeof(mouseregionrecord)*128,#0);
- lastbutton := 0;
- inverted := 0;
- fillchar(keybuf,250,#0);
- keybufhead := 1;
- keybuftail := 1;
- LastStatus := 0;
- LastX := 0;
- LastY := 0;
- end;
-
- Procedure RipObj.MouseOn;
- begin
- if not mouseexist then
- exit;
- if ismouseon then
- exit;
- regs.ax := $01;
- intr($33,regs);
- ismouseon := true;
- end;
-
- Procedure RipObj.MouseOff;
- begin
- if not mouseexist then
- exit;
- if not ismouseon then
- exit;
- regs.ax := $02;
- intr($33,regs);
- ismouseon := false;
- end;
-
- Procedure RipObj.GetPosition(var ButtonStatus,xPos,yPos:Integer);
- {absolute coords}
- {ButtonStatus : Bit 0 - Left Button is down
- Bit 1 - Right Button is down
- Bit 2 - Middle Button is down }
- begin
- if not mouseexist then
- exit;
- regs.ax := $03;
- intr($33,regs);
- buttonstatus := regs.bx;
- xpos := regs.cx;
- ypos := regs.dx;
- end;
-
- Procedure RipObj.SetMousePos(x,y:Integer);
- {absolute coords}
- begin
- if not mouseexist then
- exit;
- regs.ax := $04;
- regs.cx := x;
- regs.dx := y;
- intr($33,regs);
- end;
-
- Procedure RipObj.IsButtonDown(Button:Integer; var Status,DnCount,xPos,yPos:Integer);
- begin
- if not mouseexist then
- exit;
- regs.ax := $05;
- regs.bx := button;
- intr($33,regs);
- status := regs.ax;
- dncount := regs.bx;
- xpos := regs.cx;
- ypos := regs.dx;
- end;
-
- Procedure RipObj.IsButtonUp(Button:Integer; var Status,UpCount,xPos,yPos:Integer);
- begin
- if not mouseexist then
- exit;
- regs.ax := $06;
- regs.bx := button;
- intr($33,regs);
- status := regs.ax;
- upcount := regs.bx;
- xpos := regs.cx;
- ypos := regs.dx;
- end;
-
- Function FlagOn(Flags : word; FlagMask : word) : Boolean;
- begin
- FlagOn := (Flags and FlagMask) <> 0;
- end;
-
- Procedure RipObj.CheckMouse;
- { ax : intrmask (see below)
- bx : button status
- cx : current x position
- dx : current y position}
- var
- bx,cx,dx : integer;
- begin
- if not mouseexist then
- exit;
- GetPosition(bx,cx,dx);
- if flagon(bx,$1) and (not flagon(laststatus,$1)) then {if leftbutton just pushed}
- begin
- curregion := inregion(cx,dx);
- if curregion <> 0 then
- begin
- if regionarray[curregion].invert then
- begin
- inverted := curregion;
- doinvert(curregion,true);
- end;
- curbutton := curregion;
- end
- else
- curbutton := 0;
- end;
-
- if flagon(bx,$1) and flagon(laststatus,$1) then {if leftbutton down and not just pushed}
- begin
- CurRegion := InRegion(cx,dx);
- if curregion = curbutton then
- begin
- if (inverted <> curbutton) and regionarray[curregion].invert then
- begin
- doinvert(curregion,true);
- inverted := curregion;
- end;
- end
- else
- begin
- if inverted <> 0 then
- begin
- doinvert(curbutton,false);
- inverted := 0;
- end;
- end;
- end;
-
- if (not flagon(bx,$1)) and flagon(laststatus,$1) and (curbutton <> 0) then
- {if leftbutton just released then}
- begin
- curregion := inregion(cx,dx);
- if curregion = curbutton then
- begin
- if regionarray[curregion].invert then
- doinvert(curbutton,false);
- if regionarray[curbutton].reset then
- begin
- {do |!*}
- end;
- addstring(regionarray[curbutton].thetext);
- end;
- inverted := 0;
- curbutton := 0;
- end;
- laststatus := bx;
- lastx := cx;
- lasty := dx;
- end;
-
- Function RipObj.InRegion(x,y:word):byte;
- var
- c : byte;
- begin
- if not mouseexist then
- exit;
- for c := lastbutton downto 1 do
- begin
- inregion := c;
- with regionarray[c] do
- begin
- if (x >= x0) and (x <= x1) and (y >= y0) and (y <= y1) then
- exit;
- end;
- end;
- inregion := 0;
- end;
-
- Procedure RipObj.DoInvert(region:byte;InvertIt:boolean);
- var
- cb : pointer;
- cbsize : word;
- wason : boolean;
- begin
- if not mouseexist then
- exit;
- with regionarray[region] do
- begin
- wason := ismouseon;
- if wason then
- MouseOff;
- cbsize := imagesize(x0,y0,x1,y1);
- getmem(cb,cbsize);
- getimage(x0,y0,x1,y1,cb^);
- putimage(x0,y0,cb^,4{NOT});
- freemem(cb,cbsize);
- if wason then
- MouseOn;
- end;
- end;
-
- Procedure RipObj.AddRegion(x0,y0,x1,y1:word;invert,reset:boolean;thetext:str50);
- begin
- if not mouseexist then
- exit;
- inc(lastbutton);
- regionarray[lastbutton].x0 := x0;
- regionarray[lastbutton].y0 := y0;
- regionarray[lastbutton].x1 := x1;
- regionarray[lastbutton].y1 := y1;
- regionarray[lastbutton].invert := invert;
- regionarray[lastbutton].reset := reset;
- regionarray[lastbutton].thetext := thetext;
- end;
-
- Function RipObj.CharInBuffer: boolean;
- begin
- if not mouseexist then
- begin
- charinbuffer := false;
- exit;
- end;
- CharInBuffer := KeyBufHead <> KeyBufTail;
- end;
-
- Function RipObj.GetNextChar:char;
- begin
- getnextchar := #0;
- if not mouseexist then
- exit;
- if KeyBufHead <> KeyBufTail then
- begin
- getnextchar := keybuf[keybufhead];
- inc(keybufhead);
- if keybufhead > 250 then
- keybufhead := 1;
- end;
- end;
-
- Procedure RipObj.AddString(st:string);
- var
- s : string;
- c : byte;
- begin
- if not mouseexist then
- exit;
- c := 0;
- s := '';
- while c < length(st) do
- begin
- inc(c);
- if st[c] = '^' then
- begin
- inc(c);
- if upcase(st[c]) in ['A'..'Z'] then
- begin
- s := s + char(byte(upcase(st[c]))-64);
- end
- else
- begin
- s := s + '^' + st[c];
- end;
- end
- else
- begin
- s := s + st[c];
- end;
- end;
- for c := 1 to length(s) do
- begin
- KeyBuf[KeyBufTail] := s[c];
- inc(keybuftail);
- if keybuftail > 250 then
- keybuftail := 1;
- end;
- end;
-
- Procedure RipObj.KillRegions;
- begin
- if not mouseexist then
- exit;
- fillchar(regionarray,sizeof(mouseregionrecord)*128,#0);
- lastbutton := 0;
- end;
-
- Procedure RipObj.KillBuffer;
- begin
- if not mouseexist then
- exit;
- fillchar(keybuf,250,#0);
- keybufhead := 1;
- keybuftail := 1;
- end;
- {$ENDIF}
-
- Procedure DoNada;
- var
- thevar,
- thevar2 : string;
- begin
- thevar := theripcopyright;
- thevar2 := theripcopyright2;
- end;
-
- {*** Ansi Emulator***}
-
- procedure RipObj.PutQueue(C : Char);
- begin
- if QueueIndex < QueueSize then
- begin
- Inc(QueueIndex);
- Queue^[QueueIndex] := C;
- end;
- end;
-
- procedure RipObj.ProcessChar(C : Char; var pCommand : CommandRecord);
-
- procedure ErrorCondition;
- begin
- pCommand.Cmd := eError;
- InitParser;
- end;
-
- begin
- PutQueue(C); {put char in queue in case of subsequent error}
- with pCommand do
- begin
- Ch := C;
- Cmd := eNone;
- end;
- case ParserState of
- GotNone :
- if C = Escape then
- ParserState := GotEscape
- else
- if C = FormFeed then
- pCommand.Cmd := eClearScreen
- else
- pCommand.Cmd := eChar;
- GotEscape :
- if C = LeftBracket then
- ParserState := GotBracket
- else
- ErrorCondition;
- GotParam,
- GotBracket,
- GotSemicolon : {need a parameter char, semicolon or command}
- if (C >= #48) and (C <= #57) then
- begin
- BuildParam(C);
- ParserState := GotParam;
- end
- else
- begin
- if C = Semicolon then
- begin
- if ParserState = GotSemicolon then
- ErrorCondition
- else
- begin
- ParserState := GotSemicolon;
- Inc(ParamIndex);
- if ParamIndex > AnsiMaxParams then
- ErrorCondition;
- end;
- end
- else
- begin
- MakeCommand(C, pCommand);
- InitParser;
- end;
- end;
- end;
- end;
-
- procedure RipObj.InitParser;
- begin
- ParamIndex := 1;
- FillChar(Params,SizeOf(Params),0);
- ParserState := GotNone;
- QueueIndex := 0;
- end;
-
- procedure RipObj.BuildParam(C : Char);
- begin
- Params[ParamIndex] := Params[ParamIndex] + C;
- end;
-
- procedure RipObj.ConvertParams(C : Char);
- var
- I, Code : Integer;
- begin
- for I := 1 to AnsiMaxParams do
- begin
- Val(Params[I], ParamInt[I], Code);
- if Code <> 0 then
- ParamInt[I] := 1;
- end;
- if (Length(Params[1]) = 0) and (C in ['J', 'K']) then
- ParamInt[1] := 2;
- end;
-
- procedure RipObj.MakeCommand(C : Char; var pCommand : CommandRecord);
- var
- I, TextFg, TextBk : Byte;
- begin
- ConvertParams(C);
- with pCommand do
- begin
- Ch := C;
- case C of
- 'f', 'H' : begin
- Cmd := eGotoXY;
- X := ParamInt[2];
- Y := ParamInt[1];
- end;
- 'A' : begin
- Cmd := eUp;
- Y := ParamInt[1];
- end;
- 'B' : begin
- Cmd := eDown;
- Y := ParamInt[1];
- end;
- 'C' : begin
- Cmd := eRight;
- X := ParamInt[1];
- end;
- 'D' : begin
- cmd := eLeft;
- X := ParamInt[1];
- end;
- 'J' : begin
- case ParamInt[1] of
- 0 : Cmd := eClearBelow;
- 1 : Cmd := eClearAbove;
- 2 : Cmd := eClearScreen;
- else
- Cmd := eChar;
- end;
- end;
- 'K' : begin
- case ParamInt[1] of
- 0 : Cmd := eClearEndOfLine;
- 1 : Cmd := eClearStartOfLine;
- 2 : Cmd := eClearLine;
- else
- Cmd := eChar;
- end;
- end;
- 'h' : begin
- Cmd := eSetMode;
- X := ParamInt[1];
- end;
- 'm' : begin
- Cmd := eSetAttribute;
- X := aTextAttr;
- for I := 1 to ParamIndex do
- begin
- if Inverse then
- begin
- Blink := X and $80 = $80;
- Intense := X and $08 = $08;
- X := X and $77;
-
- X := Byte((Word(X) shl 4) or (Word(X) shr 4));
- end;
-
- TextFg := X and $0F;
- TextBk := X and $F0;
-
- case ParamInt[I] of
- 0 : begin
- X := $07; {White on black}
- Inverse := False;
- Intense := False;
- Blink := False;
- Invis := False;
- end;
- 1 : Intense := True; {Set intense bit later}
- 4 : Intense := True; {Subst intense for underline}
- 5 : Blink := True; {set blinking on}
- 7 : Inverse := True; {Invert TextAttr later}
- 8 : Invis := True; {Invisible}
- 27 : Inverse := False; {Stop inverting TextAttr}
- 30 : X := TextBk or $00; {Black foreground}
- 31 : X := TextBk or $04; {Red foreground}
- 32 : X := TextBk or $02; {Green foreground}
- 33 : X := TextBk or $06; {Yellow forground}
- 34 : X := TextBk or $01; {Blue foreground}
- 35 : X := TextBk or $05; {Magenta foreground}
- 36 : X := TextBk or $03; {Cyan foreground}
- 37 : X := TextBk or $07; {White foreground}
- 40 : X := TextFg;
- 41 : X := TextFg or $40; {Red background}
- 42 : X := TextFg or $20; {Green background}
- 43 : X := TextFg or $60; {Yellow background}
- 44 : X := TextFg or $10; {Blue background}
- 45 : X := TextFg or $50; {Magenta background}
- 46 : X := TextFg or $30; {Cyan background}
- 47 : X := TextFg or $70; {White background}
- end;
- end;
-
- if Inverse then
- X := Byte((Word(X) shl 4) or (Word(X) shr 4));
- if Inverse then
- X := X and $7F;
- if Invis then
- X := $00;
- if Intense then
- X := X or $08;
- if Blink then
- X := X or $80;
- aTextAttr := X;
- end;
- 's' : Cmd := eSaveCursorPos;
- 'u' : Cmd := eRestoreCursorPos;
- 'n' : cmd := eDeviceStatusReport;
- else
- Cmd := eError;
- end;
- end;
- end;
-
- {*** Text Window Methods ***}
-
- Procedure RipObj.DoTextStr(s:string);
- var
- ctr : byte;
- begin
- for ctr := 1 to length(s) do
- DoTextChar(s[ctr]);
- end;
-
- Procedure RipObj.DoTextChar(c:char);
- {General processing procedure for text window}
- var
- fst : fillsettingstype;
- ctr : byte;
- begin
- ProcessChar(c,CmdRec);
- case CmdRec.Cmd of
- eNone : ;
- eChar : if localrip and textactive then DispChar(CmdRec.Ch);
- eGotoXY : rGotoXY(CmdRec.X,CmdRec.Y);
- eUp : begin {cursor up}
- if cursory-CmdRec.x >= texty0 then
- rGotoXY(cursorx,cursory-CmdRec.x);
- end;
- eDown : begin {cursor down}
- if cursory+CmdRec.x <= texty1 then
- rGotoXY(cursorx,cursory+CmdRec.x);
- end;
- eRight : begin {cursor right}
- if cursorx+CmdRec.x <= textx1 then
- rGotoXY(cursorx+CmdRec.x,cursory);
- end;
- eLeft : begin {cursor left}
- if cursorx-CmdRec.x >= textx0 then
- rGotoXY(cursorx-CmdRec.x,cursory);
- end;
- eClearBelow : ; {clear screen below cursor}
- eClearAbove : ; {clear screen above cursor}
- eClearScreen : begin {clear entire screen}
- if LocalRip and TextActive then
- begin
- {$IFDEF MOUSE}
- MouseOff;
- {$ENDIF}
- getfillsettings(fst);
- setfillstyle(0,textclr and $F0);
- fillchar(virtualwindow,7826,#0);
- Bar(TextOffsetX[textsize]*textx0,TextOffsetY[textsize]*texty0,
- TextOffsetX[textsize]*(textx1+1)-1,TextOffsetY[textsize]*(texty1+1)-1);
- setfillstyle(fst.pattern,fst.color);
- rHome;
- {$IFDEF MOUSE}
- MouseOn;
- {$ENDIF}
- end;
- end;
- eClearEndofLine : begin {clear from cursor to end of line}
- if LocalRip and TextActive then
- begin
- {$IFDEF MOUSE}
- MouseOff;
- {$ENDIF}
- getfillsettings(fst);
- setfillstyle(0,textclr and $F0);
- Bar(TextOffsetX[textsize]*cursorx,TextOffsetY[textsize]*cursory,
- TextOffsetX[textsize]*(textx1+1)-1,TextOffsetY[textsize]*(cursory+1)-1);
- for ctr := cursorx to TextMaxX[textsize] do
- virtualwindow[ctr,cursory,0] := 0;
- setfillstyle(fst.pattern,fst.color);
- rHome;
- {$IFDEF MOUSE}
- MouseOn;
- {$ENDIF}
- end;
- end;
- eClearStartOfLine : ; {clear from cursor to the start of line}
- eClearLine : begin {clear entire line that cursor is on}
- if LocalRip and TextActive then
- begin
- {$IFDEF MOUSE}
- MouseOff;
- {$ENDIF}
- getfillsettings(fst);
- setfillstyle(0,textclr and $F0);
- Bar(TextOffsetX[textsize]*textx0,TextOffsetY[textsize]*cursory,
- TextOffsetX[textsize]*(textx1+1)-1,TextOffsetY[textsize]*(cursory+1)-1);
- for ctr := 0 to TextMaxX[textsize] do
- virtualwindow[ctr,cursory,0] := 0;
- setfillstyle(fst.pattern,fst.color);
- rHome;
- {$IFDEF MOUSE}
- MouseOn;
- {$ENDIF}
- end;
- end;
- eSetAttribute : textclr := CmdRec.X;
- eSaveCursorPos : begin
- cursorsavex := cursorx;
- cursorsavey := cursory;
- end;
- eRestoreCursorPos : begin
- cursorx := cursorsavex;
- cursory := cursorsavey;
- end;
- end;
- end;
-
- Procedure RipObj.DispChar(c:char);
- begin
- if (cursorx = TextX1) and textwrap then
- begin
- if (cursory <> TextY1) then
- begin
- cursorx := TextX0;
- inc(cursory);
- end;
- end;
- seek(textfontfile,byte(c)); {scrolling on y!}
- read(textfontfile,textchar);
- if c in [#0,#7,#8,#10,#12,#13,#255] then
- begin
- if c = #13 then
- begin
- cursorx := textx0;
- { if cursory < texty1 then
- inc(cursory);}
- end;
- if c = #10 then
- if cursory < texty1 then
- inc(cursory);
- if c = #8 then
- begin
- if cursorx > textx0 then
- dec(cursorx);
- end;
- end
- else
- begin
- {$IFDEF MOUSE}
- MouseOff;
- {$ENDIF}
- DisplayChar(TextOffsetX[textsize]*cursorx,TextOffsetY[textsize]*cursory,textclr and $0F,(textclr and $F0) shr 4,
- textchar,textsize);
- {$IFDEF MOUSE}
- MouseOn;
- {$ENDIF}
- end;
- virtualwindow[cursorx,cursory,0] := byte(c);
- virtualwindow[cursorx,cursory,1] := textclr;
- if (cursorx <> textx1) and not (c in [#0,#7,#8,#10,#12,#13,#255]) then
- inc(cursorx);
- end;
-
- Begin
- DoNada;
- Registered := false;
- UnregDelay := true;
- End.
-